home *** CD-ROM | disk | FTP | other *** search
/ SGI Hot Mix 17 / Hot Mix 17.iso / HM17_SGI / research / lib / obsolete / palette.pro < prev    next >
Text File  |  1997-07-08  |  10KB  |  310 lines
  1. ; $Id: palette.pro,v 1.2 1997/01/15 04:02:19 ali Exp $
  2. ;
  3. ; Copyright (c) 1988-1997, Research Systems, Inc.  All rights reserved.
  4. ;       Unauthorized reproduction prohibited.
  5.  
  6. pro draw_bar, bar
  7.  
  8. on_error,2                      ;Return to caller if an error occurs
  9. sx = bar.x1 - bar.x0 + 1
  10. if bar.inten_0 ne bar.inten_1 then $
  11.     z = byte(bar.inten_0 + findgen(sx) * (bar.inten_1 - bar.inten_0)/sx) $
  12.   else z = replicate(bar.inten_0,sx)
  13.  
  14. for i=bar.y0, bar.y1 do tv,z,bar.x0,i
  15. xyouts, bar.x0, bar.y1+2, strtrim(string(bar.minv,format=bar.nfmt),2),/dev
  16. xyouts, bar.x1, bar.y1+2, strtrim(string(bar.maxv,format=bar.nfmt),2),/dev,align=1.0
  17. xyouts, (bar.x1 + bar.x0)/2, bar.y1+2, bar.title, align=0.5,/dev
  18. plots,[bar.x0-1, bar.x0-1,bar.x1+1,bar.x1+1,bar.x0-1],$    ;incribe it
  19.     [bar.y0,bar.y1,bar.y1,bar.y0,bar.y0],/dev
  20. end
  21.  
  22.  
  23.  
  24. pro palette_back
  25. common palette_common,nc, nc1, nc2, wxsize, wysize, $
  26.     colors,  bars, rect, array, cell_size, c_array
  27.  
  28. on_error,2                      ;Return to caller if an error occurs
  29. ramp = bytscl(indgen(256),top=nc1)
  30. for i=wysize-30,wysize-5 do tv,ramp,10,i
  31. x0 = 270 & x1 = 295
  32. y1 = wysize - 5 & y0 = wysize - 140
  33. rect = [[x0,y0],[x1,y0],[x1,y1],[x0,y1],[x0,y0]]
  34. x0 = x0 -1
  35. y1 = y1 + 1
  36. plots, [[x0,y0],[x1,y0],[x1,y1],[x0,y1],[x0,y0]],/dev
  37. ;define bar structure
  38. a = { slide_bar, x0:0, y0:0, x1:0, y1:0, title:'', minv:0.0, maxv:0.0, $
  39.     inten_0:0, inten_1:0, nfmt:'', str_val:'', value: 1, s: [0.,0.] }
  40. nbars = 3
  41. bars = replicate(a,nbars)    ;make 3 of them
  42. bar_wid = 200
  43. bar_x0 = 10
  44.  
  45. bars.x0 = bar_x0
  46. bars.x1 = bar_x0 + bar_wid
  47. bars.y1 = wysize-60 - findgen(nbars) * 40
  48. bars.y0 = bars.y1 - 20
  49. bars.title= ['Red','Green','Blue']
  50.  
  51. bars.nfmt= ['(i3)','(i3)','(i3)']
  52. bars.minv = [0,0,0]
  53. bars.maxv = [255,255,255]
  54. bars.inten_0 = [0,0,0]        ;dark bars
  55. bars.inten_1 = bars.inten_0
  56. ; Equation to cvt from screen to data.
  57. bars.s(1) = float(bars.maxv - bars.minv) / (bars.x1 - bars.x0)
  58. bars.s(0) = bars.minv - bars.s(1) * bars.x0
  59.  
  60. for i=0,nbars-1 do draw_bar, bars(i)
  61.  
  62. cell_size = 17
  63. c_array = [10, 10+17*16, wysize - 170, wysize - 170 - 17*((nc+15)/16)]
  64.  
  65. x = (indgen(16*cell_size)/cell_size) # replicate(1,cell_size)  ;ramp
  66. for i = 0,(nc-1)/16 do begin
  67.     tv,x,c_array(0),c_array(2)-(i+1)*cell_size
  68.     x = x + 16 < nc1
  69.     endfor
  70.  
  71. for i=0,16 do begin
  72.     x0 = c_array(0) + i*17
  73.     plots,[x0,x0],[c_array(2),c_array(3)],/dev
  74.     endfor
  75. for i=0,(nc+15)/16 do begin
  76.     y0 = c_array(2) - i*17
  77.     plots,[c_array(0),c_array(1)],[y0,y0],/dev
  78.     endfor
  79. xyouts,10,5,'Undo Current Color',/dev
  80. xyouts,wxsize-5, 5,'Undo All',/dev,ali=1.0
  81. xyouts,10,30,'Help',/dev
  82. end
  83.  
  84.  
  85. pro update_bar, i, v    ;update bar(i) with new value v
  86. common palette_common,nc, nc1, nc2, wxsize, wysize, $
  87.     colors,  bars, rect, array, cell_size, c_array
  88.  
  89. on_error,2                      ;Return to caller if an error occurs
  90. a = bars(i)    ;get struct
  91. x = (a.value - a.s(0))/a.s(1)    ;old X
  92. plots,[x,x],[a.y0+1,a.y1-1],/dev,col=0    ;Erase line
  93. x = (v-a.s(0))/a.s(1)    ;New Screen X
  94. plots,[x,x],[a.y0+1,a.y1-1],/dev,col=255 ;new line
  95. bars(i).value = v        ;store new value
  96.  
  97. xyouts, a.x1+5, a.y0+3 ,a.str_val,col=0,/dev ;erase old string value
  98. bars(i).str_val = strtrim(string(v,format=a.nfmt),2)
  99. xyouts, a.x1+5, a.y0+3 ,bars(i).str_val,color=nc1,/dev ;new string value
  100. end
  101.  
  102.  
  103.  
  104. pro palette
  105. ;+
  106. ; NAME:
  107. ;    PALETTE
  108. ;
  109. ; PURPOSE:
  110. ;    Interactively create color tables based on
  111. ;    the RGB color system using the mouse, three sliders,
  112. ;    and a cell for each color index.  Single colors can be
  113. ;    defined and multiple color indices between two endpoints
  114. ;    can be interpolated.
  115. ;
  116. ; CATEGORY:
  117. ;    Color tables.
  118. ;
  119. ; CALLING SEQUENCE:
  120. ;    PALETTE
  121. ;
  122. ; INPUTS:
  123. ;    No explicit inputs.  The current color table is used as a starting
  124. ;    point.
  125. ;
  126. ; KEYWORD PARAMETERS:
  127. ;    None.
  128. ;
  129. ; OUTPUTS:
  130. ;    None.
  131. ;
  132. ; COMMON BLOCKS:
  133. ;    COLORS:    Contains the current RGB color tables.
  134. ;
  135. ; SIDE EFFECTS:
  136. ;    The new color tables are saved in the COLORS common block and loaded
  137. ;    to the display.
  138. ;
  139. ; RESTRICTIONS:
  140. ;    Only works with window systems.  
  141. ;
  142. ; PROCEDURE:
  143. ;    A window is created with:
  144. ;
  145. ;    1) A color ramp at the top.
  146. ;    2) A rectangle containing the current color index at upper left.
  147. ;    3) Three slider bars for red, green, and blue.
  148. ;    4) An array of cells, one for each color index.
  149. ;    5) Buttons for help, undo current color, and undo all at the bottom.
  150. ;
  151. ;    To use the PALETTE tool:
  152. ;    Select the color index to be modified by clicking the mouse in the 
  153. ;    cell array over the color to be changed.  The index of this color
  154. ;    appears under the upper right rectangle.
  155. ;
  156. ;    Move the mouse to the slider bars and vary the color content
  157. ;    by depressing the left button within these bars.
  158. ;
  159. ;    You can interpolate all color indices between two endpoints
  160. ;    by defining the color first for one endpoint, and then 
  161. ;    for the other.  Move the mouse back to the cell of the first endpoint
  162. ;    and click the center button.  The colors between the two endpoints 
  163. ;    change to a smooth gradient between the two points.
  164. ;
  165. ;    Exit this procedure and save the colors by clicking the
  166. ;    right button.
  167. ;
  168. ;    The current color can be restored by clicking "Undo Current
  169. ;    Color".
  170. ;
  171. ;    All colors are restored to their entry values by clicking
  172. ;    "Undo All".
  173. ;
  174. ;    You can access the new color tables by declaring the common block
  175. ;    COLORS, as shown below (PALETTE sets both the original and current 
  176. ;    arrays):
  177. ;
  178. ;        COMMON COLORS, R_ORIG, G_ORIG, B_ORIG, R_CURR, G_CURR, B_CURR
  179. ;
  180. ;    Users of the Motif and OPEN LOOK window systems can use XPALETTE, 
  181. ;    a widgets version of PALETTE.
  182. ;
  183. ; MODIFICATION HISTORY:
  184. ;    DMS, September, 1988.
  185. ;
  186. ;       SNG, December, 1990.    Added support for DOS version, only supports
  187. ;                                 640 x 480 x 16 display mode.
  188. ;
  189. ;    SMR, March, 1991.    Fixed a bug where the existing IDL window was
  190. ;                used instead of creating a new window.
  191. ;-
  192.  
  193. common palette_common,nc, nc1, nc2, wxsize, wysize, $
  194.     colors,  bars, rect, array, cell_size, c_array
  195. common colors, r_orig, g_orig, b_orig, r_curr, g_curr, b_curr
  196.  
  197. on_error,2              ;Return to caller if an error occurs
  198. nc = !d.table_size    ;# of colors avail
  199. if nc eq 0 then message, "Device has static color tables.  Can't modify."
  200.  
  201. psave = !p        ;Save !p
  202. nc1 = nc -1
  203. nc2 = nc1-1        ;Current color
  204. !p.noclip = 1        ;No clipping
  205. !p.color = nc1        ;Foreground color
  206. !p.font = 0        ;Hdw font
  207. if ((!d.flags and 256) EQ 256) then $
  208.     old_window = !d.window    ;Previous window
  209. device,get_write=old_mask,set_write=255 ;Enable all bits
  210.  
  211. if n_elements(r_curr) eq 0 then begin
  212.     r_orig = bytscl(indgen(nc)) & g_orig = r_orig & b_orig = r_orig
  213.     r_curr = r_orig & g_curr = r_orig & b_curr = r_orig
  214.     endif
  215. wxsize = 300        ;Window size
  216. wysize = 220 + ((nc+15)/16) * 17
  217. if ((!d.flags and 256) ne 0) then $
  218.     window,xs=wxsize, ys=wysize, title='Palette',/free
  219.  
  220. tvcrs,.5,.5,/norm
  221.  
  222. restart:
  223. palette_back
  224. colors = fix( [[r_curr],[g_curr],[b_curr]])  ;n by 3 array
  225. tvlct,colors(*,0),colors(*,1),colors(*,2) ;load current color tbl
  226. curr_color = 0        ;current color index
  227. col = 0
  228. csave = colors(0,*)
  229. ;        *** Main loop ***
  230.  
  231. next:
  232. tvrdc,x,y,/dev        ;read mouse with wait
  233. if !err eq 4 then goto, done
  234.  
  235. next2:
  236. for i=0,2 do if (y ge bars(i).y0) and (y le bars(i).y1) then begin
  237.     a = bars(i)        ;Bar struct
  238.     v = fix(a.s(0) + a.s(1) * x) < a.maxv > a.minv    ;data value
  239.     if v eq a.value then goto, next3
  240.     update_bar,i,v
  241.     colors(curr_color,i) = v ;Save color value
  242.     tvlct,colors(curr_color,0),colors(curr_color,1), $
  243.         colors(curr_color,2),curr_color
  244. next3:    tvrdc,x,y,/dev,0
  245.     if (!err eq 1) then goto,next2
  246. ; Check for new color mark
  247. endif else if (y gt c_array(3)) and (y lt c_array(2)) then begin
  248.     xx = (x - c_array(0))/17
  249.     yy = (c_array(2) - y)/17
  250.     col = (xx + yy * 16) < nc1
  251.     if col eq curr_color then goto,next3    ;Same color?
  252.     csave = colors(col,*)        ;save current colors
  253.     xyouts,rect(0,0),rect(1,0)-15,strtrim(curr_color,2),col=0,/dev
  254.     xyouts,rect(0,0),rect(1,0)-15,strtrim(col,2),/dev
  255.     polyfill,/dev,rect,col=col    ;Fill upper corner rect
  256.     for i=0,2 do update_bar,i,colors(col,i) ;new bars
  257.     if (!err eq 2) then begin    ;interpolate??
  258.         i0 = col < curr_color
  259.         i1 = col > curr_color
  260.         kc = i1 - i0        ;# to interpolate
  261.         c = float(colors(i0,*))
  262.         del = (colors(i1,*) - c)/(i1-i0) ;interp
  263.         colors(i0,0) = findgen(kc) # del + $
  264.          (replicate(1,kc) # c)
  265.         tvlct,colors(*,0),colors(*,1),colors(*,2)
  266.         endif
  267.     curr_color = col
  268.     goto, next3
  269. endif else if (y ge 30) and (y le 45) then begin
  270.     print,' '
  271.     print,'  Use left button to select a color index from the color grid.'
  272.     print,'  Then vary the color by moving the mouse in the color slider'
  273.     print,'bars with the left button depressed.'
  274.     print,' Interpolate all color indices between two colors by defining'
  275.     print,'the two end point colors. Then mark one endpoint cell with'
  276.     print,'the left button and the other endpoint with the center button.'
  277.     print,'  Right button saves the color tables and exits this procedure.'
  278.     print,' '
  279.     goto, next
  280. endif else if (y le !d.y_ch_size + 5) then begin    ;Undo current color?
  281.     if (x lt wxsize/2) then begin    ;undo color?
  282.         colors(col,0) = csave    ;yes
  283.         for i=0,2 do update_bar,i,colors(col,i)
  284.         tvlct,colors(col,0),colors(col,1), colors(col,2),curr_color
  285.     endif else begin
  286.         erase    ;begin again
  287.         goto, restart
  288.     endelse
  289. endif
  290.  
  291. goto,next
  292.  
  293.  
  294. done:
  295.     r_orig = (r_curr = colors(*,0))    ;save in common block
  296.         g_orig = (g_curr = colors(*,1))
  297.         b_orig = (b_curr = colors(*,2))
  298.         if ((!d.flags and 256) ne 0) then begin
  299.           wdelete            ;kill window
  300.       if old_window ge 0 then begin    ;restore window?
  301.         tvcrs,0.5,0.5,/norm    ;show the table
  302.         empty
  303.         tvcrs            ;hide cursor
  304.         endif
  305. device,set_write=old_mask        ;Restore old write mask
  306.         endif
  307. !p = psave
  308. end
  309.  
  310.